home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / LWP / TkIO.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  2.2 KB  |  105 lines
  1. package LWP::IO;
  2.  
  3.  
  4. require Tk;
  5. require LWP::Debug;
  6.  
  7. =head1 NAME
  8.  
  9. LWP::TkIO - Tk I/O routines for the LWP library
  10.  
  11. =head1 SYNOPSIS
  12.  
  13.  use Tk;
  14.  require LWP::TkIO;
  15.  require LWP::UserAgent;
  16.  
  17. =head1 DESCRIPTION
  18.  
  19. This module provide replacement functions for the LWP::IO
  20. functions. Require this module if you use Tk and want non exclusive IO
  21. behaviour from LWP.  This does not allow LWP to run simultaneous
  22. requests though.
  23.  
  24. See also L<LWP::IO>.
  25.  
  26. =cut
  27.  
  28.  
  29. sub read
  30. {
  31.     my $fd = shift;
  32.     my $dataRef = \$_[0];
  33.     my $size    =  $_[1];
  34.     my $offset  =  $_[2] || 0;
  35.     my $timeout =  $_[3];
  36.  
  37.     my $doneFlag = 0;
  38.     my $timeoutFlag = 0;
  39.     my $n;
  40.  
  41.     Tk->fileevent($fd, 'readable',
  42.           sub {
  43.               $n = sysread($fd, $$dataRef, $size, $offset);
  44.               LWP::Debug::conns("Read $n bytes: '" .
  45.                     substr($$dataRef, $offset, $n) .
  46.                     "'") if defined $n;
  47.               $doneFlag = 1;
  48.           }
  49.          );
  50.     my $timer = Tk->after($timeout*1000, sub {$timeoutFlag = 1;} );
  51.  
  52.     Tk::DoOneEvent(0) until ($doneFlag || $timeoutFlag);
  53.  
  54.     Tk->after(cancel => $timer);
  55.     Tk->fileevent($fd, 'readable', ''); # no more callbacks
  56.     die "Timeout" if $timeoutFlag;
  57.     return $n;
  58. }
  59.  
  60.  
  61. sub write
  62. {
  63.     my $fd = shift;
  64.     my $dataRef = \$_[0];
  65.     my $timeout =  $_[1];
  66.  
  67.     my $len = length $$dataRef;
  68.  
  69.     return 0 unless $len;
  70.  
  71.     my $offset = 0;
  72.     my $timeoutFlag = 0;
  73.     my $doneFlag = 0;
  74.  
  75.     my $timeoutSub = sub { $timeoutFlag = 1; };
  76.     my $timer;
  77.     $timer = Tk->after($timeout*1000, $timeoutSub ) if $timeout;
  78.  
  79.     Tk->fileevent($fd, 'writable',
  80.           sub {
  81.               my $n = syswrite($fd, $$dataRef, $len-$offset, $offset);
  82.               if (!defined $n) {
  83.               $done = 1;
  84.               } else {
  85.               LWP::Debug::conns("Write $n bytes: '" .
  86.                         substr($$dataRef, $offset, $n) .
  87.                         "'");
  88.               $offset += $n;
  89.               $timer = Tk->after($timeout*1000, $timeoutSub )
  90.                 if $timeout;
  91.               }
  92.           }
  93.          );
  94.  
  95.     Tk::DoOneEvent(0) until ($timeoutFlag || $doneFlag || $offset >= $len);
  96.  
  97.     Tk->fileevent($fd, 'writable', ''); # no more callbacks
  98.     Tk->after(cancel => $timer) if $timeout;
  99.  
  100.     die "Timeout" if $timeoutFlag;
  101.     $offset;
  102. }
  103.  
  104. 1;
  105.